home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / Development / ncurses-5.3 / Ada95 / samples / ncurses2-acs_display.adb < prev    next >
Encoding:
Text File  |  2002-10-27  |  10.3 KB  |  232 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                                 ncurses                                  --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 2000 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  37. --  Version Control
  38. --  $Revision: 1.1 $
  39. --  Binding Version 01.00
  40. ------------------------------------------------------------------------------
  41. with ncurses2.util; use ncurses2.util;
  42. with ncurses2.genericPuts;
  43. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  44.  
  45. with Ada.Strings.Unbounded;
  46. with Ada.Strings.Fixed;
  47.  
  48. procedure ncurses2.acs_display is
  49.    use Int_IO;
  50.  
  51.    procedure show_upper_chars (first : Integer);
  52.    function  show_1_acs (N    : Integer;
  53.                          name : String;
  54.                          code :  Attributed_Character)
  55.                         return Integer;
  56.    procedure show_acs_chars;
  57.  
  58.  
  59.    procedure show_upper_chars (first : Integer)  is
  60.       C1 : Boolean := (first = 128);
  61.       last : Integer := first + 31;
  62.       package p is new ncurses2.genericPuts (200);
  63.       use p;
  64.       use p.BS;
  65.       use Ada.Strings.Unbounded;
  66.  
  67.       tmpa : Unbounded_String;
  68.       tmpb : BS.Bounded_String;
  69.    begin
  70.       Erase;
  71.       Switch_Character_Attribute
  72.         (Attr => (Bold_Character => True, others => False));
  73.       Move_Cursor (Line => 0, Column => 20);
  74.       tmpa := To_Unbounded_String ("Display of ");
  75.       if C1 then
  76.          tmpa := tmpa & "C1";
  77.       else
  78.          tmpa := tmpa & "GR";
  79.       end if;
  80.       tmpa := tmpa & " Character Codes ";
  81.       myPut (tmpb, first);
  82.       Append (tmpa, To_String (tmpb));
  83.       Append (tmpa, " to ");
  84.       myPut (tmpb, last);
  85.       Append (tmpa, To_String (tmpb));
  86.       Add (Str => To_String (tmpa));
  87.       Switch_Character_Attribute
  88.         (On => False,
  89.          Attr => (Bold_Character => True, others => False));
  90.       Refresh;
  91.  
  92.       for code in first .. last loop
  93.          declare
  94.             row : Line_Position := Line_Position (4 + ((code - first) mod 16));
  95.             col : Column_Position := Column_Position (((code - first) / 16) *
  96.                                                       Integer (Columns) / 2);
  97.             tmp3 : String (1 .. 3);
  98.             tmpx : String (1 .. Integer (Columns / 4));
  99.             reply : Key_Code;
  100.          begin
  101.             Put (tmp3, code);
  102.             myPut (tmpb, code, 16);
  103.             tmpa := To_Unbounded_String (tmp3 & " (" & To_String (tmpb) & ')');
  104.  
  105.             Ada.Strings.Fixed.Move (To_String (tmpa), tmpx,
  106.                                     Justify => Ada.Strings.Right);
  107.             Add (Line => row, Column => col,
  108.                  Str => tmpx & ' ' & ':' & ' ');
  109.             if C1 then
  110.                Set_NoDelay_Mode (Mode => True);
  111.             end if;
  112.             Add_With_Immediate_Echo (Ch => Code_To_Char (Key_Code (code)));
  113.             --  TODO check this
  114.             if C1 then
  115.                reply := Getchar;
  116.                while reply /= Key_None loop
  117.                   Add (Ch => Code_To_Char (reply));
  118.                   Nap_Milli_Seconds (10);
  119.                   reply := Getchar;
  120.                end loop;
  121.                Set_NoDelay_Mode (Mode => False);
  122.             end if;
  123.          end;
  124.       end loop;
  125.    end show_upper_chars;
  126.  
  127.    function show_1_acs (N    : Integer;
  128.                         name : String;
  129.                         code :  Attributed_Character)
  130.                        return Integer is
  131.       height : constant Integer := 16;
  132.       row : Line_Position := Line_Position (4 + (N mod height));
  133.       col : Column_Position := Column_Position ((N / height) *
  134.                                                 Integer (Columns) / 2);
  135.       tmpx : String (1 .. Integer (Columns) / 3);
  136.    begin
  137.       Ada.Strings.Fixed.Move (name, tmpx,
  138.                               Justify => Ada.Strings.Right,
  139.                               Drop => Ada.Strings.Left);
  140.       Add (Line => row, Column => col, Str => tmpx & ' ' & ':' & ' ');
  141.       --  we need more room than C because our identifiers are longer
  142.       --  22 chars actually
  143.       Add (Ch => code);
  144.       return N + 1;
  145.    end show_1_acs;
  146.  
  147.    procedure show_acs_chars is
  148.       n : Integer;
  149.    begin
  150.       Erase;
  151.       Switch_Character_Attribute
  152.         (Attr => (Bold_Character => True, others => False));
  153.       Add (Line => 0, Column => 20,
  154.            Str => "Display of the ACS Character Set");
  155.       Switch_Character_Attribute (On => False,
  156.                                   Attr => (Bold_Character => True,
  157.                                            others => False));
  158.       Refresh;
  159.  
  160.       --  the following is useful to generate the below
  161.       --  grep '^[ ]*ACS_' ../src/terminal_interface-curses.ads |
  162.       --  awk '{print  "n := show_1_acs(n, \""$1"\", ACS_Map("$1"));"}'
  163.  
  164.       n := show_1_acs (0, "ACS_Upper_Left_Corner",
  165.                        ACS_Map (ACS_Upper_Left_Corner));
  166.       n := show_1_acs (n, "ACS_Lower_Left_Corner",
  167.                        ACS_Map (ACS_Lower_Left_Corner));
  168.       n := show_1_acs (n, "ACS_Upper_Right_Corner",
  169.                        ACS_Map (ACS_Upper_Right_Corner));
  170.       n := show_1_acs (n, "ACS_Lower_Right_Corner",
  171.                        ACS_Map (ACS_Lower_Right_Corner));
  172.       n := show_1_acs (n, "ACS_Left_Tee", ACS_Map (ACS_Left_Tee));
  173.       n := show_1_acs (n, "ACS_Right_Tee", ACS_Map (ACS_Right_Tee));
  174.       n := show_1_acs (n, "ACS_Bottom_Tee", ACS_Map (ACS_Bottom_Tee));
  175.       n := show_1_acs (n, "ACS_Top_Tee", ACS_Map (ACS_Top_Tee));
  176.       n := show_1_acs (n, "ACS_Horizontal_Line",
  177.                        ACS_Map (ACS_Horizontal_Line));
  178.       n := show_1_acs (n, "ACS_Vertical_Line", ACS_Map (ACS_Vertical_Line));
  179.       n := show_1_acs (n, "ACS_Plus_Symbol", ACS_Map (ACS_Plus_Symbol));
  180.       n := show_1_acs (n, "ACS_Scan_Line_1", ACS_Map (ACS_Scan_Line_1));
  181.       n := show_1_acs (n, "ACS_Scan_Line_9", ACS_Map (ACS_Scan_Line_9));
  182.       n := show_1_acs (n, "ACS_Diamond", ACS_Map (ACS_Diamond));
  183.       n := show_1_acs (n, "ACS_Checker_Board", ACS_Map (ACS_Checker_Board));
  184.       n := show_1_acs (n, "ACS_Degree", ACS_Map (ACS_Degree));
  185.       n := show_1_acs (n, "ACS_Plus_Minus", ACS_Map (ACS_Plus_Minus));
  186.       n := show_1_acs (n, "ACS_Bullet", ACS_Map (ACS_Bullet));
  187.       n := show_1_acs (n, "ACS_Left_Arrow", ACS_Map (ACS_Left_Arrow));
  188.       n := show_1_acs (n, "ACS_Right_Arrow", ACS_Map (ACS_Right_Arrow));
  189.       n := show_1_acs (n, "ACS_Down_Arrow", ACS_Map (ACS_Down_Arrow));
  190.       n := show_1_acs (n, "ACS_Up_Arrow", ACS_Map (ACS_Up_Arrow));
  191.       n := show_1_acs (n, "ACS_Board_Of_Squares",
  192.                        ACS_Map (ACS_Board_Of_Squares));
  193.       n := show_1_acs (n, "ACS_Lantern", ACS_Map (ACS_Lantern));
  194.       n := show_1_acs (n, "ACS_Solid_Block", ACS_Map (ACS_Solid_Block));
  195.       n := show_1_acs (n, "ACS_Scan_Line_3", ACS_Map (ACS_Scan_Line_3));
  196.       n := show_1_acs (n, "ACS_Scan_Line_7", ACS_Map (ACS_Scan_Line_7));
  197.       n := show_1_acs (n, "ACS_Less_Or_Equal", ACS_Map (ACS_Less_Or_Equal));
  198.       n := show_1_acs (n, "ACS_Greater_Or_Equal",
  199.                        ACS_Map (ACS_Greater_Or_Equal));
  200.       n := show_1_acs (n, "ACS_PI", ACS_Map (ACS_PI));
  201.       n := show_1_acs (n, "ACS_Not_Equal", ACS_Map (ACS_Not_Equal));
  202.       n := show_1_acs (n, "ACS_Sterling", ACS_Map (ACS_Sterling));
  203.  
  204.    end show_acs_chars;
  205.  
  206.    c1 : Key_Code;
  207.    c : Character := 'a';
  208. begin
  209.    loop
  210.       case c is
  211.          when 'a' =>
  212.             show_acs_chars;
  213.          when '0' | '1' | '2' | '3' =>
  214.             show_upper_chars (ctoi (c) * 32 + 128);
  215.          when others =>
  216.             null;
  217.       end case;
  218.       Add (Line => Lines - 3, Column => 0,
  219.            Str => "Note: ANSI terminals may not display C1 characters.");
  220.       Add (Line => Lines - 2, Column => 0,
  221.            Str => "Select: a=ACS, 0=C1, 1,2,3=GR characters, q=quit");
  222.       Refresh;
  223.       c1 := Getchar;
  224.       c := Code_To_Char (c1);
  225.       exit when c = 'q' or c = 'x';
  226.    end loop;
  227.    Pause;
  228.    Erase;
  229.    End_Windows;
  230. end ncurses2.acs_display;
  231.  
  232.